home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbucmd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-21  |  12.7 KB  |  432 lines
  1. (*===========================================================================*)
  2. (* Command processor                                                         *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. {$UNDEF  debug}
  12. {$UNDEF  DEBUG_REVIEW}
  13.  
  14. UNIT BBUCMD;
  15.  
  16. INTERFACE
  17.  
  18. PROCEDURE user_command(cmd_string : STRING);
  19.  
  20. IMPLEMENTATION
  21.  
  22. USES
  23.   CRT,
  24.   bbactcmd,
  25.   bbauth,
  26.   bbconsl,
  27.   bbconv,
  28.   bbdb1,
  29.   bbdummy,
  30.   bbbin,
  31.   bbbug,
  32.   bbfsd,
  33.   bbfsu,
  34.   bbfsw,
  35.   bbfwds,
  36.   bbhelp,
  37.   bbkmc,
  38.   bblmc,
  39.   bbmdata,
  40.   bbmess,
  41.   bbmisc,
  42.   bbmisc2,
  43.   bbmisc4,
  44.   bbocmd,
  45.   bbopro,
  46.   bbopru,
  47.   bbreg,
  48.   bbrmc,
  49.   bbsdata,
  50.   bbsess,
  51.   bbsmc,
  52.   bbstr,
  53.   bbtcmd,
  54.   bbtime;
  55.  
  56. (*===========================================================================*)
  57. (* Execute a user command                                                    *)
  58. (*===========================================================================*)
  59.  
  60. PROCEDURE user_command(cmd_string : STRING);
  61.  
  62.   TYPE p_ptr = PROCEDURE(str_parm : STRING);
  63.  
  64.   VAR
  65.     cmd_word      : STRING[20];
  66.     exec_char     : CHAR;
  67.     op_command    : BOOLEAN;
  68.     rebuild       : BOOLEAN;
  69.     uc            : user_class_type;
  70.     uf            : WORD;
  71.     wd            : WORD;
  72.     word_count    : BYTE;
  73.  
  74.   {$I BBUCMDMC.PAS}                        (* Mode change                    *)
  75.   {$I BBUCMDLT.PAS}                        (* LTIME  command                 *)
  76.  
  77.   (*=========================================================================*)
  78.   (* Check for restricted command                                            *)
  79.   (*=========================================================================*)
  80.  
  81.   FUNCTION is_restricted : BOOLEAN;
  82.  
  83.     VAR
  84.       i : BYTE;
  85.  
  86.     BEGIN;
  87.  
  88.       is_restricted := TRUE;
  89.  
  90.       i := active_port^.u_restrict;
  91.  
  92.       IF ((i AND restrict_send) <> 0)     AND (exec_char = 'S') THEN
  93.         EXIT;
  94.  
  95.       IF ((i AND restrict_upload) <> 0)   AND (exec_char = 'U') THEN
  96.         EXIT;
  97.  
  98.       IF ((i AND restrict_download) <> 0) AND (exec_char = 'D') THEN
  99.         EXIT;
  100.  
  101.       IF ((i AND restrict_listread) <> 0) AND (POS(exec_char, 'LRV') <> 0) THEN
  102.         EXIT;
  103.  
  104.       is_restricted := FALSE;
  105.  
  106.     END;
  107.  
  108.   (*=========================================================================*)
  109.   (* Main line                                                               *)
  110.   (*=========================================================================*)
  111.  
  112.   BEGIN;
  113.  
  114.     (*-----------------------------------------------------------------------*)
  115.     (* Isolate the command string                                            *)
  116.     (*-----------------------------------------------------------------------*)
  117.  
  118.     strip_crlf(cmd_string);
  119.  
  120.     (*-----------------------------------------------------------------------*)
  121.     (* Remove leading LF (if any)                                            *)
  122.     (*-----------------------------------------------------------------------*)
  123.  
  124.     WHILE (LENGTH(cmd_string) > 0) AND (cmd_string[1] = lf) DO
  125.       cmd_string := COPY(cmd_string, 2, 255);
  126.  
  127.     (*-----------------------------------------------------------------------*)
  128.     (* If we didn't get one, ignore this                                     *)
  129.     (*-----------------------------------------------------------------------*)
  130.  
  131.     IF LENGTH(cmd_string) = 0 THEN
  132.       EXIT;
  133.  
  134.     (*-----------------------------------------------------------------------*)
  135.     (* Isolate the command word                                              *)
  136.     (*-----------------------------------------------------------------------*)
  137.  
  138.     word_count := words(cmd_string);
  139.  
  140.     cmd_word := upcase_str(subword(@cmd_string, 1, 1));
  141.  
  142.     (*-----------------------------------------------------------------------*)
  143.     (* Get user info                                                         *)
  144.     (*-----------------------------------------------------------------------*)
  145.  
  146.     uc := active_tcb^.uid_data.user_class;
  147.     uf := active_tcb^.uid_data.user_flag;
  148.  
  149.     (*-----------------------------------------------------------------------*)
  150.     (* Check for reverse forward command from a BBS.  When it returns        *)
  151.     (* force a "B"                                                           *)
  152.     (*-----------------------------------------------------------------------*)
  153.  
  154.     IF (cmd_word = 'F>') AND (uc = user_c_bu) THEN
  155.       BEGIN;
  156.         op_command := reverse_forward;
  157.         send_drain;
  158.         IF NOT op_command THEN
  159.           task_wait(2, FALSE);
  160.         end_session(op_command);
  161.       END;
  162.  
  163.     (*-----------------------------------------------------------------------*)
  164.     (* Handle aliases                                                        *)
  165.     (*-----------------------------------------------------------------------*)
  166.  
  167.     rebuild := FALSE;
  168.  
  169.     IF cmd_word = 'HELP' THEN
  170.       BEGIN;
  171.         cmd_word := 'H';
  172.         rebuild  := TRUE;
  173.       END;
  174.  
  175.     IF cmd_word = 'BYE' THEN
  176.       BEGIN;
  177.         cmd_word := 'B';
  178.         rebuild  := TRUE;
  179.       END;
  180.  
  181.     IF cmd_word = 'INFO' THEN
  182.       BEGIN;
  183.         cmd_word := 'I';
  184.         rebuild  := TRUE;
  185.       END;
  186.  
  187.     IF cmd_word = 'REGISTER' THEN
  188.       BEGIN;
  189.         cmd_word := 'N';
  190.         rebuild  := TRUE;
  191.       END;
  192.  
  193.     IF cmd_word = 'REPLY' THEN
  194.       BEGIN;
  195.         cmd_word := 'SR';
  196.         rebuild  := TRUE;
  197.       END;
  198.  
  199.     IF (cmd_word = 'EXPERT') OR
  200.           ((cmd_word = 'X') AND (uc <= user_c_bu)) THEN
  201.       BEGIN;
  202.         cmd_word := 'NE';
  203.         rebuild  := TRUE;
  204.       END;
  205.  
  206.     IF (cmd_word = 'SYSOPMSG') AND (word_count = 1) THEN
  207.       BEGIN;
  208.         cmd_word   := 'S~';
  209.         cmd_string := 'S~'
  210.       END;
  211.  
  212.     IF rebuild THEN
  213.       BEGIN;
  214.         cmd_string := cmd_word + ' ' + subword(@cmd_string, 2, 0);
  215.         strip_var(cmd_string, 'T');
  216.       END;
  217.  
  218.     (*-----------------------------------------------------------------------*)
  219.     (* Handle special commands                                               *)
  220.     (*-----------------------------------------------------------------------*)
  221.  
  222.     IF cmd_word = 'REVIEW' THEN
  223.       BEGIN;
  224.  
  225.         {$IFDEF DEBUG_REVIEW}
  226.           WRITELN('Review in = ', cmd_string);
  227.         {$ENDIF}
  228.  
  229.         cmd_string := 'V' + subword(@cmd_string, 2, 0);
  230.  
  231.         IF cmd_string = 'V' THEN
  232.           BEGIN;
  233.             IF uc >= user_c_rsu THEN
  234.               cmd_string := 'VV'
  235.             ELSE
  236.               cmd_string := 'VM';
  237.           END;
  238.  
  239.         cmd_word := subword(@cmd_string, 1, 1);
  240.         word_count := words(cmd_string);
  241.  
  242.         {$IFDEF DEBUG_REVIEW}
  243.           WRITELN('Review out = ', cmd_string);
  244.         {$ENDIF}
  245.  
  246.       END;
  247.  
  248.     (*-----------------------------------------------------------------------*)
  249.     (* See if sysop wants something                                          *)
  250.     (*-----------------------------------------------------------------------*)
  251.  
  252.     {$IFDEF debug}
  253.       WRITELN('OC=', ORD(active_tcb^.tcb_type));
  254.       DELAY(2000);
  255.     {$ENDIF}
  256.  
  257.     IF active_tcb^.tcb_sysop_pw_ok AND (uc >= user_c_rsu) THEN
  258.       BEGIN;
  259.  
  260.         op_command := op_cmd(@cmd_string);
  261.  
  262.         IF op_command THEN EXIT;
  263.  
  264.       END;
  265.  
  266.     (*-----------------------------------------------------------------------*)
  267.     (* Long commands                                                         *)
  268.     (*-----------------------------------------------------------------------*)
  269.  
  270.     IF (cmd_word = 'CALLBOOK') OR (cmd_word = 'CB') THEN
  271.       BEGIN;
  272.         sam_ulookup_call(cmd_string);
  273.         EXIT;
  274.       END;
  275.  
  276.     IF cmd_word = 'LTIME' THEN
  277.       BEGIN;
  278.         l_time_set;
  279.         EXIT;
  280.       END;
  281.  
  282.     (*-----------------------------------------------------------------------*)
  283.     (* Command must be 2 characters of less if we get here                   *)
  284.     (*-----------------------------------------------------------------------*)
  285.  
  286.     IF LENGTH(cmd_word) > 2 THEN
  287.       BEGIN;
  288.         send_message(message_unknown_cmd);
  289.         active_tcb^.error_sw := TRUE;
  290.         EXIT;
  291.       END;
  292.  
  293.     (*-----------------------------------------------------------------------*)
  294.     (* See if this is a mode change.  Allowed only if                        *)
  295.     (*   1.  User can be remote sysop and port allows sysop                  *)
  296.     (*   2.  User can be BBS                                                 *)
  297.     (*   3.  User is local SYSOP                                             *)
  298.     (*-----------------------------------------------------------------------*)
  299.  
  300.     IF (cmd_word[1] = '@') AND
  301.              ((((uf AND user_f_sysop) <> 0) AND active_port^.port_r_sysop)
  302.                              OR ((uf AND user_f_bbs) <> 0)
  303.                              OR active_tcb^.tcb_console) THEN
  304.         BEGIN;
  305.           user_mode_change;
  306.           EXIT;
  307.         END;
  308.  
  309.     (*-----------------------------------------------------------------------*)
  310.     (* Now see if this user is restricted                                    *)
  311.     (*-----------------------------------------------------------------------*)
  312.  
  313.     IF (active_port^.u_restrict <> 0)
  314.           AND (((uf AND (user_f_restrict OR user_f_reg_modem)) <> 0)
  315.                                       OR (uc < active_port^.port_restrict))
  316.           AND is_restricted THEN
  317.       BEGIN;
  318.         send_message(message_cmd_restrict);
  319.         active_tcb^.error_sw := TRUE;
  320.       END;
  321.  
  322.     (*-----------------------------------------------------------------------*)
  323.     (* Execute two-letter commands                                           *)
  324.     (*-----------------------------------------------------------------------*)
  325.  
  326.     IF cmd_word = 'DU' THEN
  327.       BEGIN;
  328.         oper_du(cmd_string);
  329.         EXIT;
  330.       END;
  331.  
  332.     IF (cmd_word = 'DB') OR (cmd_word = 'UB') THEN
  333.       BEGIN;
  334.         bin_cmd(cmd_string);
  335.         EXIT;
  336.       END;
  337.  
  338.     IF cmd_word = 'PL' THEN
  339.       BEGIN;
  340.         IF active_port^.port_type = port_modem THEN
  341.           BEGIN;
  342.             active_port^.modem_crlf := NOT active_port^.modem_crlf;
  343.             switch_show(active_port^.modem_crlf);
  344.           END
  345.         ELSE
  346.             switch_show(FALSE);
  347.         EXIT;
  348.       END;
  349.  
  350.     IF (cmd_word[1] = 'V')
  351.                 AND ((LENGTH(cmd_word) > 1) OR (word_count > 1)) THEN
  352.       BEGIN;
  353.  
  354.         {$IFDEF DEBUG_REVIEW}
  355.           WRITELN('V command = ', cmd_string);
  356.           DELAY(2000);
  357.         {$ENDIF}
  358.  
  359.         read_msg_cmd(cmd_string);
  360.  
  361.         EXIT;
  362.  
  363.       END;
  364.  
  365.     (*-----------------------------------------------------------------------*)
  366.     (* Execute one letter commands                                           *)
  367.     (*-----------------------------------------------------------------------*)
  368.  
  369.     CASE cmd_word[1] OF
  370.       'B' : BEGIN;
  371.               IF (LENGTH(cmd_string) <> 1) OR (word_count > 1) THEN
  372.                 BEGIN;
  373.                   send_message(message_unknown_cmd);
  374.                   active_tcb^.error_sw := TRUE;
  375.                   EXIT;
  376.                 END;
  377.  
  378.               IF (active_tcb^.tcb_type = th_operator)
  379.                                 OR (active_tcb^.tcb_type = th_fwd_control) THEN
  380.                 BEGIN;
  381.                   close_operator_session;
  382.                   EXIT;
  383.                  END;
  384.  
  385.               send_message(message_goodbye);
  386.               end_session(FALSE);
  387.             END;
  388.  
  389.       'D' : down_file_cmd(cmd_string);
  390.  
  391.       'H', '?' : help_cmd(cmd_string);
  392.       'I' : BEGIN;
  393.               wd := MEMAVAIL div 1024;
  394.               STR(wd, cmd_word);
  395.               set_dollar1_parm (@cmd_word);
  396.               send_message(message_info);
  397.             END;
  398.  
  399.       'J' : activity_cmd(cmd_string);
  400.  
  401.       'K' : kill_msg_cmd(cmd_string);
  402.       'L' : list_msg_cmd(cmd_string);
  403.       'N' : register_cmd(cmd_string);
  404.  
  405.       'R' : read_msg_cmd(cmd_string);
  406.  
  407.       'S' :
  408.             BEGIN;
  409.               send_msg_cmd(cmd_string);
  410.               active_tcb^.tcb_rcv_msg := FALSE;
  411.             END;
  412.  
  413.       'T' : talk_cmd(cmd_string);
  414.  
  415.       'U' : upload_file_cmd(cmd_string);
  416.  
  417.       'V' : send_tnc_data_str(this_bbs_version + cr);
  418.  
  419.       'W' : list_dir_cmd(cmd_string);
  420.  
  421.       ELSE
  422.         BEGIN;
  423.           send_message(message_unknown_cmd);
  424.           active_tcb^.error_sw := TRUE;
  425.         END;
  426.  
  427.     END;
  428.  
  429.   END;
  430.  
  431. END.
  432.